{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit TagParser;

interface

uses
  Classes, MP3Tags, M4ATags, WMAFile, VideoTags;

type
  TAHMTagType = (ttMP3, ttM4A, ttWMA, ttVideo, ttImage, ttUnknown);

  TAHMMediaTags = class
  private
    FURL: WideString;
    FPath: WideString;
    FFilename: WideString;
    FTitle: String;
    FTitleArtist: String;
    FCompTitle: String;
    FCompArtist: String;
    FGenre: String;
    FYear: Word;
    FTrack: Word;
    FDuration: LongWord;
    FBitrate: LongWord;
    FImageURL: WideString;
  protected
    function GetCaption: String;
    function GetMatchGenre: String;
    function GetMatchCompilation: String;
    function GetMatchArtist: String;
  public
    property Caption: String read GetCaption;
    property MatchGenre: String read GetMatchGenre;
    property MatchCompilation: String read GetMatchCompilation;
    property MatchArtist: String read GetMatchArtist;
    property URL: WideString read FURL write FURL;
    property Path: WideString read FPath write FPath;
    property Filename: WideString read FFilename write FFilename;
    property Title: String read FTitle write FTitle;
    property TitleArtist: String read FTitleArtist write FTitleArtist;
    property CompilationTitle: String read FCompTitle write FCompTitle;
    property CompilationArtist: String read FCompArtist write FCompArtist;
    property Genre: String read FGenre write FGenre;
    property Year: Word read FYear write FYear;
    property TrackNumber: Word read FTrack write FTrack;
    property Duration: LongWord read FDuration write FDuration;
    property Bitrate: LongWord read FBitrate write FBitrate;
    property ImageURL: WideString read FImageURL write FImageURL;
    procedure Clean;
    procedure Clear;
    procedure Assign(Source: TAHMMediaTags);
  end;

  TAHMTagReader = class
  private
    FPath: WideString;
    FFilename: WideString;
    FTags: TAHMMediaTags;
  protected
    procedure SetPath(Path: WideString);
    procedure SetFilename(Filename: WideString);
    procedure SetThumbPath(Path: WideString); virtual;
    procedure SetCreateThumbs(CreateThumbs: Boolean); virtual;
    procedure Clear; virtual;
    procedure Initialise; virtual;
    procedure Finalise; virtual;
  public
    constructor Create;
    destructor Destroy; override;
    property Tags: TAHMMediaTags read FTags;
    property Path: WideString read FPath write SetPath;
    property Filename: WideString read FFilename write SetFilename;
    property ThumbnailPath: WideString write SetThumbPath;
    property CreateThumbnails: Boolean write SetCreateThumbs;
    function Parse: Boolean; virtual; abstract;
  end;

  TAHMFileTagReader = class(TAHMTagReader)
  private
  protected
  public
    function Parse: Boolean; override;
  end;

  TAHMID3TagReader = class(TAHMTagReader)
  private
    FHelper: TAHMMP3File;
  protected
    procedure SetThumbPath(Path: WideString); override;
    procedure SetCreateThumbs(CreateThumbs: Boolean); override;
    procedure Initialise; override;
    procedure Finalise; override;
  public
    function Parse: Boolean; override;
  end;

  TAHMM4ATagReader = class(TAHMTagReader)
  private
    FHelper: TAHMM4AFile;
  protected
    procedure SetThumbPath(Path: WideString); override;
    procedure SetCreateThumbs(CreateThumbs: Boolean); override;
    procedure Initialise; override;
    procedure Finalise; override;
  public
    function Parse: Boolean; override;
  end;

  TAHMWMATagReader = class(TAHMTagReader)
  private
    FHelper: TWMAFile;
  protected
    procedure Initialise; override;
    procedure Finalise; override;
  public
    function Parse: Boolean; override;
  end;

  TAHMVideoTagReader = class(TAHMTagReader)
  private
    FHelper: TAHMVideoFile;
  protected
    procedure SetThumbPath(Path: WideString); override;
    procedure SetCreateThumbs(CreateThumbs: Boolean); override;
    procedure Initialise; override;
    procedure Finalise; override;
  public
    function Parse: Boolean; override;
  end;

  TAHMMediaTagParser = class
  private
    FReader: TAHMTagReader;
    FFileReader: TAHMFileTagReader;
    FID3Reader: TAHMID3TagReader;
    FM4AReader: TAHMM4ATagReader;
    FWMAReader: TAHMWMATagReader;
    FVideoReader: TAHMVideoTagReader;
    FThumbPath: WideString;
    FCreateThumbs: Boolean;
  protected
    procedure SetThumbPath(Path: WideString);
    procedure SetCreateThumbs(CreateThumbs: Boolean);
  public
    constructor Create;
    destructor Destroy; override;
    property ThumbnailPath: WideString read FThumbPath write SetThumbPath;
    property CreateThumbnails: Boolean read FCreateThumbs write SetCreateThumbs;
    function Parse(const Path, Filename: WideString): TAHMMediaTags;
    function ThumbnailURL(const SourceURL: WideString): WideString;
  end;


function GetTagType(Filename: WideString): TAHMTagType;
function GetAlbumArtMatch(Filename: WideString): Integer;

var
  IncludeMP3Tags: Boolean;
  IncludeM4ATags: Boolean;
  IncludeWMATags: Boolean;
  IncludeAVITags: Boolean;
  IncludeMPGTags: Boolean;
  IncludeMPEGTags: Boolean;
  IncludeWMVTags: Boolean;

implementation

uses
  SysUtils, StrUtils, AHMConsts, TagUtils, UniCode;

function GetTagType(Filename: WideString): TAHMTagType;
var
  i: Integer;
  Ext: WideString;
begin
  // Get extension of passed filename
  Ext := ExtractFileExtW(WideUpperCase(FileName));

  // Try our supported tag formats
  if (Ext = EXT_MP3) and IncludeMP3Tags then Result := ttMP3
  else if (Ext = EXT_M4A) and IncludeM4ATags then Result := ttM4A
  else if (Ext = EXT_WMA) and IncludeWMATags then Result := ttWMA
  else if (Ext = EXT_AVI) and IncludeAVITags then Result := ttVideo
  else if (Ext = EXT_MPG) and IncludeMPGTags then Result := ttVideo
  else if (Ext = EXT_MPEG) and IncludeMPEGTags then Result := ttVideo
  else if (Ext = EXT_WMV) and IncludeWMVTags then Result := ttVideo
  else Result := ttUnknown;

  // If unknown check for standard supported image type
  if Result = ttUnknown then
  begin
    for i := Low(EXT_IMAGES) to High(EXT_IMAGES) do
      if Ext = EXT_IMAGES[i] then
      begin
        Result := ttImage;
        Break;
      end;
  end;
end;

function GetAlbumArtMatch(Filename: WideString): Integer;
begin
  // Determine the quality of the specified album art filename by
  // looking for known name patterns matching pre-generated artwork
  FileName := WideLowerCase(FileName);
  if Pos('folder', FileName) <> 0 then Result := 14
  else if Pos('front', FileName) <> 0 then Result := 12
  else if Pos('cover', FileName) <> 0 then Result := 10
  else if Pos('album', FileName) <> 0 then Result := 8
  else if Pos('dis', FileName) <> 0 then Result := 6
  else if Pos('cd', FileName) <> 0 then Result := 4
  else if Pos('art', FileName) <> 0 then Result := 2
  else Result := 0;

  // Prefer higher resolution images
  if Pos('large', FileName) <> 0 then Inc(Result);
end;

// TAHMMediaTags

procedure TAHMMediaTags.Clean;
var
  i: Integer;
  Temp: String;
begin
  // Trim tags used for sorting/grouping
  FTitle := Trim(FTitle);
  FTitleArtist := Trim(FTitleArtist);
  FCompTitle := Trim(FCompTitle);
  FCompArtist := Trim(FCompArtist);
  FGenre := Trim(FGenre);

  // Replace blank title tag with filename minus extension
  if FTitle = '' then FTitle := ExtractFileCaptionW(FFilename);

  // Artist clean up - remove any crappy collaboration suffix
  Temp := LowerCase(FTitleArtist);
  i := Pos(' vs', Temp);
  if i = 0 then i := Pos(' vers', Temp);
  if i = 0 then i := Pos(' ft', Temp);
  if i = 0 then i := Pos(' feat', Temp);
  if i = 0 then i := Pos(' presents', Temp);
  if i = 0 then i := Pos(' with', Temp);
  if i = 0 then i := Pos('; ', Temp);
  if i = 0 then i := Pos(' - ', Temp);
  if i = 0 then
  begin
    // Remove suffix in brackets except for (The)
    i := Pos(' (', Temp);
    if (i > 0) and (Copy(Temp, i + 2, 3) = 'the') then i := 0;
  end;
  if i > 0 then FTitleArtist := Copy(FTitleArtist, 1, i - 1);

  // Move 'The' artist prefix to a suffix - except for 'The The'
  Temp := LowerCase(FTitleArtist);
  if (Copy(Temp, 1, 4) = 'the ') and (Temp <> 'the the') then
    FTitleArtist := Copy(FTitleArtist, 5, MaxInt) + ' (The)';

  // Capitalise first char of title & artist
  if Length(FTitle) > 0 then FTitle[1] := UpCase(FTitle[1]);
  if Length(FTitleArtist) > 0 then FTitleArtist[1] := UpCase(FTitleArtist[1]);
end;

procedure TAHMMediaTags.Clear;
begin
  FURL := '';
  FPath := '';
  FFilename := '';
  FTitle := '';
  FTitleArtist := '';
  FCompTitle := '';
  FCompArtist := '';
  FGenre := '';
  FYear := 0;
  FDuration := 0;
  FBitrate := 0;
  FImageURL := '';
end;

function TAHMMediaTags.GetCaption: String;
begin
//TODO: check uRL for artist substring
{ algorithm is as follows:

if artist name is a substring of folders string then
  display name = title only. album artist = title artist
else
  display name = title artist + title. album artist = various

this should work reasonably well so long as artist string is not too short.
}


//TODO: determine which tags we should use here
{
  if FTitleArtist <> '' then
    if FTitle <> '' then
      Result := FTitleArtist + ' / ' + FTitle
    else
      Result := FTitleArtist
  else }
    Result := FTitle;
end;

function TAHMMediaTags.GetMatchGenre: String;
var
  i: Integer;
begin
  Result := UpperCase(FGenre);

  // Remove any punctuation and white space from genre and ignore case
  for i := Length(Result) downto 1 do
    if not (Result[i] in ['A'..'Z', '0'..'9']) then
      Delete(Result, i, 1);
end;

function TAHMMediaTags.GetMatchCompilation: String;
var
  i: Integer;
begin
  Result := UpperCase(FCompTitle);

  // Remove any punctuation and white space from album and ignore case
  for i := Length(Result) downto 1 do
    if not (Result[i] in ['A'..'Z', '0'..'9']) then
      Delete(Result, i, 1);
end;

function TAHMMediaTags.GetMatchArtist: String;
var
  i: Integer;
begin
  // Remove '(The)' suffix added previously
  Result := UpperCase(FTitleArtist);
  i := Pos(' (THE', Result);
  if i > 0 then Result := (Copy(Result, 1, i - 1));

  // Remove any punctuation and white space from artist and ignore case
  for i := Length(Result) downto 1 do
    if not (Result[i] in ['A'..'Z', '0'..'9']) then
      Delete(Result, i, 1);
end;

procedure TAHMMediaTags.Assign(Source: TAHMMediaTags);
begin
  if Source = nil then Clear
  else
  begin
    FURL := Source.URL;
    FPath := Source.Path;
    FFilename := Source.Filename;
    FTitle := Source.Title;
    FTitleArtist := Source.TitleArtist;
    FCompTitle := Source.CompilationTitle;
    FCompArtist := Source.CompilationArtist;
    FGenre := Source.Genre;
    FYear := Source.Year;
    FDuration := Source.Duration;
    FBitrate := Source.Bitrate;
    FImageURL := Source.ImageURL;
  end;
end;

// TAHMTagReader

constructor TAHMTagReader.Create;
begin
  inherited;

  FTags := TAHMMediaTags.Create;

  Initialise;
end;

destructor TAHMTagReader.Destroy;
begin
  Finalise;

  FTags.Free;

  inherited;
end;

procedure TAHMTagReader.SetPath(Path: WideString);
begin
  FPath := Path;
  FTags.Path := FPath;
end;

procedure TAHMTagReader.SetFilename(Filename: WideString);
begin
  if FFilename <> Filename then
  begin
    Clear;
    FFilename := Filename;
    FTags.Filename := FFilename;
    FTags.Path := FPath;
  end;
end;

procedure TAHMTagReader.SetThumbPath(Path: WideString);
begin
  // Descendants may implement this if required
end;

procedure TAHMTagReader.SetCreateThumbs(CreateThumbs: Boolean);
begin
  // Descendants may implement this if required
end;

procedure TAHMTagReader.Clear;
begin
  FTags.Clear;
end;

procedure TAHMTagReader.Initialise;
begin
  // Descendants may perform required setup here
end;

procedure TAHMTagReader.Finalise;
begin
  // Descendants may perform required cleanup here
end;

// TAHMFileTagReader

function TAHMFileTagReader.Parse: Boolean;
begin
  // Populate tags based on filename only
  Tags.Title := Filename;
  Tags.Clean;
  Result := True;
end;

// TAHMID3TagReader

procedure TAHMID3TagReader.SetThumbPath(Path: WideString);
begin
  FHelper.ThumbnailPath := Path;
end;

procedure TAHMID3TagReader.SetCreateThumbs(CreateThumbs: Boolean);
begin
  FHelper.CreateThumbnails := CreateThumbs;
end;

procedure TAHMID3TagReader.Initialise;
begin
  FHelper := TAHMMP3File.Create;
end;

procedure TAHMID3TagReader.Finalise;
begin
  FHelper.Free;
end;

function TAHMID3TagReader.Parse: Boolean;
begin
  Result := FHelper.OpenFile(Path + Filename) and
            FHelper.ReadTags;

  if Result then
  begin
    Tags.Title := FHelper.Title;
    Tags.TitleArtist := FHelper.Artist;
    Tags.CompilationTitle := FHelper.Album;
    Tags.CompilationArtist := FHelper.AlbumArtist;
    Tags.Genre := FHelper.Genre;
    Tags.Year := StrToIntDef(FHelper.Year, 0);
    Tags.TrackNumber := FHelper.Track;
    Tags.Duration := FHelper.Duration;
    Tags.Bitrate := FHelper.Bitrate;
    Tags.ImageURL := FHelper.ImageURL;
    Tags.Clean;
  end;

  FHelper.Close;
end;

// TAHMM4ATagReader

procedure TAHMM4ATagReader.SetThumbPath(Path: WideString);
begin
  FHelper.ThumbnailPath := Path;
end;

procedure TAHMM4ATagReader.SetCreateThumbs(CreateThumbs: Boolean);
begin
  FHelper.CreateThumbnails := CreateThumbs;
end;

procedure TAHMM4ATagReader.Initialise;
begin
  FHelper := TAHMM4AFile.Create;
end;

procedure TAHMM4ATagReader.Finalise;
begin
  FHelper.Free;
end;

function TAHMM4ATagReader.Parse: Boolean;
begin
  Result := FHelper.OpenFile(Path + Filename) and
            FHelper.ReadTags;

  if Result then
  begin
    Tags.Title := FHelper.Title;
    Tags.TitleArtist := FHelper.Artist;
    Tags.CompilationTitle := FHelper.Album;
    Tags.CompilationArtist := FHelper.AlbumArtist;
    Tags.Genre := FHelper.Genre;
    Tags.Year := StrToIntDef(FHelper.Year, 0);
    Tags.TrackNumber := FHelper.Track;
    Tags.Duration := FHelper.Duration;
    Tags.Bitrate := FHelper.Bitrate;
    Tags.ImageURL := FHelper.ImageURL;
    Tags.Clean;
  end;

  FHelper.Close;
end;

// TAHMWMATagReader

procedure TAHMWMATagReader.Initialise;
begin
  FHelper := TWMAFile.Create;
end;

procedure TAHMWMATagReader.Finalise;
begin
  FHelper.Free;
end;

function TAHMWMATagReader.Parse: Boolean;
begin
  Result := FHelper.ReadFromFile(Path + Filename) and FHelper.Valid;

  if Result then
  begin
    Tags.Title := FHelper.Title;
    Tags.TitleArtist := FHelper.Artist;
    Tags.CompilationTitle := FHelper.Album;
    Tags.CompilationArtist := FHelper.Artist;
    Tags.Genre := FHelper.Genre;
    Tags.Year := StrToIntDef(FHelper.Year, 0);
    Tags.TrackNumber := FHelper.Track;
    Tags.Duration := Trunc(FHelper.Duration);
    Tags.Bitrate := FHelper.BitRate;
    Tags.Clean;
  end;
end;

// TAHMVideoTagReader

procedure TAHMVideoTagReader.SetThumbPath(Path: WideString);
begin
  FHelper.ThumbnailPath := Path;
end;

procedure TAHMVideoTagReader.SetCreateThumbs(CreateThumbs: Boolean);
begin
  FHelper.CreateThumbnails := CreateThumbs;
end;

procedure TAHMVideoTagReader.Initialise;
begin
  FHelper := TAHMVideoFile.Create;
end;

procedure TAHMVideoTagReader.Finalise;
begin
  FHelper.Free;
end;

function TAHMVideoTagReader.Parse: Boolean;
begin
  Result := FHelper.OpenFile(Path + Filename) and
            FHelper.ReadTags;

  if Result then
  begin
    Tags.Duration := Trunc(FHelper.Duration);
    Tags.Bitrate := FHelper.BitRate;
    Tags.ImageURL := FHelper.ImageURL;
    Tags.Clean;
  end;

  FHelper.Close;
end;


// TAHMMediaTagParser

constructor TAHMMediaTagParser.Create;
begin
  inherited;

  // Create parsers for each supported media type
  FFileReader := TAHMFileTagReader.Create;
  FID3Reader := TAHMID3TagReader.Create;
  FM4AReader := TAHMM4ATagReader.Create;
  FWMAReader := TAHMWMATagReader.Create;
  FVideoReader := TAHMVideoTagReader.Create;
end;

destructor TAHMMediaTagParser.Destroy;
begin
  // Free our various media parsers
  FFileReader.Free;
  FID3Reader.Free;
  FM4AReader.Free;
  FWMAReader.Free;
  FVideoReader.Free;

  inherited;
end;

procedure TAHMMediaTagParser.SetThumbPath(Path: WideString);
begin
  if FThumbPath <> Path then
  begin
    FThumbPath := Path;

    // Ensure thumbnail directory exists & create if required
    if not DirectoryExistsW(FThumbPath) then
      CreateDirW(FThumbPath);

    // Set thumbnail path property for supported parsers
    FID3Reader.ThumbnailPath := FThumbPath;
    FM4AReader.ThumbnailPath := FThumbPath;
    FVideoReader.ThumbnailPath := FThumbPath;
  end;
end;

procedure TAHMMediaTagParser.SetCreateThumbs(CreateThumbs: Boolean);
begin
  FCreateThumbs := CreateThumbs;

  // Set create thumbnail property for supported parsers
  FID3Reader.CreateThumbnails := FCreateThumbs;
  FM4AReader.CreateThumbnails := FCreateThumbs;
  FVideoReader.CreateThumbnails := FCreateThumbs;
end;

function TAHMMediaTagParser.Parse(const Path, Filename: WideString): TAHMMediaTags;
begin
  case GetTagType(Filename) of
    ttMP3:   FReader := FID3Reader;
    ttM4A:   FReader := FM4AReader;
    ttWMA:   FReader := FWMAReader;
    ttVideo: FReader := FVideoReader;
    else     FReader := FFileReader;
  end;

  FReader.Path := Path;
  FReader.Filename := Filename;
  if FReader.Parse then Result := FReader.Tags
                   else Result := nil;
end;

function TAHMMediaTagParser.ThumbnailURL(const SourceURL: WideString): WideString;
begin
  Result := FThumbPath + GetThumbnailName(SourceURL);
end;

initialization
  // Enable all supported tag formats by default
  IncludeMP3Tags := True;
  IncludeM4ATags := True;
  IncludeWMATags := True;
  IncludeAVITags := True;
  IncludeMPGTags := True;
  IncludeMPEGTags := True;
  IncludeWMVTags := True;

end.
